home *** CD-ROM | disk | FTP | other *** search
/ SGI Developer Toolbox 6.1 / SGI Developer Toolbox 6.1 - Disc 4.iso / lib / mathlib / libfft / fft1 / noise.f < prev    next >
Encoding:
Text File  |  1994-08-02  |  3.1 KB  |  127 lines
  1. /* *****************************************************************************
  2. *
  3. * Copyright 1991, 1992, 1993, 1994, Silicon Graphics, Inc.
  4. * All Rights Reserved.
  5. *
  6. * This is UNPUBLISHED PROPRIETARY SOURCE CODE of Silicon Graphics, Inc.;
  7. * the contents of this file may not be disclosed to third parties, copied or
  8. * duplicated in any form, in whole or in part, without the prior written
  9. * permission of Silicon Graphics, Inc.
  10. *
  11. * RESTRICTED RIGHTS LEGEND:
  12. * Use, duplication or disclosure by the Government is subject to restrictions
  13. * as set forth in subdivision (c)(1)(ii) of the Rights in Technical Data
  14. * and Computer Software clause at DFARS 252.227-7013, and/or in similar or
  15. * successor clauses in the FAR, DOD or NASA FAR Supplement. Unpublished -
  16. * rights reserved under the Copyright Laws of the United States.
  17. *
  18. ***************************************************************************** */
  19.       subroutine matnoise(a,lda,nlin,ncol)
  20.       real a(lda,1)
  21. c
  22.       init = 1325
  23. c$doacross
  24.       do 35 i = 1,nlin
  25.           a(i,1) = 0.0
  26.    35 continue
  27.       do 30 j = 1,ncol
  28.          do 20 i = 1,nlin
  29.             init = mod(3125*init,65536)
  30.             a(i,j) = a(i,j) + (init - 32768.0)/16384.0
  31.    20    continue
  32.    30    continue
  33.       return
  34.       end
  35.       
  36.       subroutine matpower( nlin,ncol,mat,power,lda)
  37.       real mat(lda,*), power(lda,*)
  38.     real re, im
  39.  
  40.         il = 1
  41.         power(il,1) = mat(il,1) * mat(il,1)
  42.         do j = 2, (ncol-1)/2
  43.         re = mat(il,2*j-1)
  44.         im = mat(il,2*j)
  45.         power(il,j) = re * re + im * im
  46.         power(il,ncol-j+1) = power(il,j)
  47.         end do
  48.         if( mod(ncol,2) .eq. 2) 
  49.      $        power(il,ncol) = mat(il,ncol) * mat(il,ncol)
  50. c$doacross local(i,j,re,im)
  51.     do j = 2, ncol
  52.         do i = 2, (nlin-1)/2
  53.         re = mat(2*i-2,j)
  54.         im = mat(2*i-1,j)
  55.         power(i,j) = re * re + im * im
  56.         power(nlin-i+1,j) = power(i,j)
  57.         end do
  58.     end do
  59.         il = nlin
  60.         power(il,1) = mat(il,1) * mat(il,1)
  61.         do j = 2, (ncol-1)/2
  62.         re = mat(il,2*j-1)
  63.         im = mat(il,2*j)
  64.         power(il,j) = re * re + im * im
  65.         power(il,ncol-j+1) = power(il,j)
  66.         end do
  67.         if( mod(ncol,2) .eq. 2) 
  68.      $        power(il,ncol) = mat(il,ncol) * mat(il,ncol)
  69.     if ( mod(nlin ,2) .eq. 0) then
  70.     end if
  71.       return
  72.       end
  73.  
  74.       subroutine matlog( nlin, ncol, power, lda)
  75.       real power(lda,*)
  76.     real t
  77. c$doacross local(i,j,t)
  78.     do j = 1, ncol
  79.         do i = 1, nlin
  80.         t = power(i,j) + 1
  81.         power(i,j) = LOG(t)
  82.         end do
  83.     end do
  84.       return
  85.       end
  86.         
  87.       subroutine matcolor( nlin,ncol,mat,color,lda)
  88.       real mat(lda,*)
  89.       integer color(ncol,*)
  90.     real t, a, coeff,xx,yy
  91.     integer red, green, blue
  92.  
  93.     xx = 0.0
  94.     yy = 0.0
  95.     do j = 1, ncol
  96.         do i = 1, nlin
  97.         a = mat(i,j)
  98.         if ( a .lt. xx) then
  99.             xx = a
  100.         else if(  a .gt. yy) then
  101.             yy   = a
  102.         end if
  103.         end do
  104.     end do
  105.     coeff = MAX(ABS(xx),ABS(yy))
  106.  
  107. c    print *, ' MIN =', xx, '   MAX =', yy
  108.  
  109.     if ( coeff .gt. 0.) coeff = .99 * 255. / coeff
  110.  
  111. c$doacross local(t, a, red,blue,green,i,j)
  112.     do j = 1, ncol
  113.         do i = 1, nlin
  114.         t= mat(i,j)
  115.         a = ABS(t)
  116.         red = coeff* (a - t) 
  117.         if( red .gt. 255) red = 255
  118.         green = coeff* a
  119.         blue = coeff* (a + t)
  120.         if( blue .gt. 255) blue = 255
  121.         color(j,i) = (red) + (256*green) + (256*256*blue)
  122.         end do
  123.     end do
  124.       return
  125.       end
  126.         
  127.